home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / ABUSESRC.ZIP / AbuseSrc / abuse / src / lcache.c < prev    next >
C/C++ Source or Header  |  1996-04-11  |  3KB  |  134 lines
  1. #include "lisp.hpp"
  2. #include "specs.hpp"
  3. #include "bus_type.hpp"
  4.  
  5. long block_size(Cell *level)  // return size needed to recreate this block
  6. {
  7.   int ret;
  8.   if (!level) ret=0;    // NULL pointers don't need to be stored
  9.   else 
  10.   {
  11.     int type=item_type(level);
  12.     if (type==L_CONS_CELL)
  13.     {
  14.     long t=0; 
  15.     void *b=level;
  16.     for (;b && item_type(b)==L_CONS_CELL;b=CDR(b)) 
  17.     {
  18.       t+=sizeof(cons_cell);
  19.     }
  20.     if (b) t+=block_size(b);
  21.     for (b=level;b && item_type(b)==L_CONS_CELL;b=CDR(b))
  22.       t+=block_size(CAR(b));
  23.     ret=t;
  24.     } else if (type== L_NUMBER)
  25.     { ret=sizeof(lisp_number); } 
  26.     else if (type==L_CHARACTER)
  27.     { ret=sizeof(lisp_character); }
  28.     else if (type==L_STRING)
  29.     { 
  30.       ret=sizeof(lisp_string)+strlen(lstring_value(level))+1; 
  31.       if (ret<8)
  32.         ret=8;
  33.     }
  34.     else if (type==L_POINTER)
  35.     { ret=sizeof(lisp_pointer); }
  36.     else ret=0;
  37.   }
  38. #ifdef WORD_ALLIGN
  39.   return (ret+3)&(~3);
  40. #else
  41.   return ret;
  42. #endif
  43. }
  44.  
  45.  
  46.  
  47. void write_level(bFILE *fp, Cell *level)
  48. {
  49.   int type=item_type(level);
  50.   fp->write_byte(type);
  51.  
  52.  
  53.   switch (type)
  54.   {
  55.     case L_NUMBER :
  56.     { fp->write_long(lnumber_value(level)); } break;
  57.     case L_CHARACTER :
  58.     { fp->write_short(lcharacter_value(level)); } break;
  59.     case L_STRING :
  60.     { long l=strlen(lstring_value(level))+1;
  61.       fp->write_long(l);
  62.       fp->write(lstring_value(level),l); 
  63.     } break;
  64.     case L_SYMBOL :
  65.     { fp->write_long((long)level); } break;
  66.     case L_CONS_CELL :
  67.     {
  68.       if (!level) fp->write_long(0);
  69.       else
  70.       {
  71.     long t=0;
  72.     void *b=level;
  73.     for (;b && item_type(b)==L_CONS_CELL;b=CDR(b)) t++;
  74.     if (b) 
  75.     {
  76.       fp->write_long(-t);      // negative number means dotted list
  77.       write_level(fp,b);       // save end of dotted list     
  78.     }
  79.     else fp->write_long(t);
  80.  
  81.     for (b=level;b && item_type(b)==L_CONS_CELL;b=CDR(b))    
  82.       write_level(fp,CAR(b));
  83.       }
  84.     } break;
  85.   }
  86. }
  87.  
  88. Cell *load_block(bFILE *fp)
  89. {
  90.   int type=fp->read_byte();
  91.   switch (type)
  92.   {   
  93.     case L_NUMBER :
  94.     { return new_lisp_number(fp->read_long()); } break;
  95.     case L_CHARACTER :
  96.     { return new_lisp_character(fp->read_short()); } break;
  97.     case L_STRING :
  98.     { long l=fp->read_long();
  99.       lisp_string *s=new_lisp_string(l);
  100.       fp->read(lstring_value(s),l);
  101.       return s;
  102.     } break;
  103.     case L_SYMBOL :
  104.     { return (void *)fp->read_long(); } break;
  105.     case L_CONS_CELL :
  106.     {
  107.       long t=fp->read_long();
  108.       if (!t) return NULL;
  109.       else
  110.       {
  111.     long x=abs(t);
  112.     cons_cell *last,*first=NULL;
  113.     while (x)
  114.     {
  115.       cons_cell *c=new_cons_cell();
  116.       if (first)
  117.         last->cdr=c;
  118.       else first=c;
  119.       last=c;
  120.       x--;
  121.     }
  122.     if (t<0)    
  123.       last->cdr=load_block(fp);
  124.     else last->cdr=NULL;
  125.     
  126.     for (last=first,x=0;x<abs(t);x++,last=(cons_cell *)last->cdr)       
  127.       last->car=load_block(fp);    
  128.     return first;
  129.       }
  130.     }
  131.   }
  132.   return NULL;
  133. }
  134.